Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/str2bmp/test.frm

Text File | 1995-09-06 | 9KB | 324 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00FF0000&
   Caption         =   "Bitmap Function Tester."
   ClientHeight    =   4050
   ClientLeft      =   1860
   ClientTop       =   2190
   ClientWidth     =   7245
   ClipControls    =   0   'False
   Height          =   4455
   Left            =   1800
   LinkTopic       =   "Form1"
   ScaleHeight     =   4050
   ScaleWidth      =   7245
   Top             =   1845
   Width           =   7365
   Begin CommandButton CommandCopyResultToB
      Caption         =   "Copy RESULT to B"
      Height          =   555
      Left            =   5040
      TabIndex        =   12
      Top             =   1380
      Width           =   2055
   End
   Begin CommandButton CommandAnd
      Caption         =   "RESULT = A AND B"
      Height          =   555
      Left            =   5040
      TabIndex        =   11
      Top             =   780
      Width           =   2055
   End
   Begin PictureBox PictureResult
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   3240
      ScaleHeight     =   41
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   81
      TabIndex        =   7
      Top             =   2820
      Width           =   1215
   End
   Begin CommandButton CommandOr
      Caption         =   "RESULT = A OR B"
      Height          =   555
      Left            =   5040
      TabIndex        =   6
      Top             =   180
      Width           =   2055
   End
   Begin CommandButton CommandInvertA
      Caption         =   "Invert A"
      Height          =   555
      Left            =   5040
      TabIndex        =   5
      Top             =   3180
      Width           =   2055
   End
   Begin CommandButton CommandCompareAtoB
      Caption         =   "Compare A to B"
      Height          =   555
      Left            =   5040
      TabIndex        =   4
      Top             =   2580
      Width           =   2055
   End
   Begin PictureBox PictureA
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   360
      ScaleHeight     =   41
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   81
      TabIndex        =   3
      Top             =   2820
      Width           =   1215
   End
   Begin PictureBox PictureB
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   615
      Left            =   1800
      ScaleHeight     =   41
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   81
      TabIndex        =   2
      Top             =   2820
      Width           =   1215
   End
   Begin CommandButton CommandCopyAtoB
      Caption         =   "Copy A to B"
      Height          =   555
      Left            =   5040
      TabIndex        =   1
      Top             =   1980
      Width           =   2055
   End
   Begin CommandButton CommandDrawCircle
      Caption         =   "Draw Circles in A"
      Height          =   555
      Left            =   600
      TabIndex        =   0
      Tag             =   "Write line to A"
      Top             =   600
      Width           =   3495
   End
   Begin Label Label3
      BackColor       =   &H00FF0000&
      Caption         =   "A"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   840
      TabIndex        =   10
      Top             =   3540
      Width           =   255
   End
   Begin Label Label2
      BackColor       =   &H00FF0000&
      Caption         =   "B"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   2280
      TabIndex        =   9
      Top             =   3600
      Width           =   255
   End
   Begin Label Label1
      BackColor       =   &H00FF0000&
      Caption         =   "Result"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   12
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   3480
      TabIndex        =   8
      Top             =   3540
      Width           =   855
   End
End
Option Explicit

' Strings to hold pixel information.
Dim A$
Dim B$
Dim RESULT$

Sub CommandAnd_Click ()
  Dim bytes As Long
  Dim ret%

  bytes = BMP_GetSize(PictureA.Image)
  If (bytes = 0) Then
     MsgBox ("Bitmap too large to store!")
     End
  End If
  A$ = Space$(bytes)
  B$ = Space$(bytes)
  RESULT$ = Space$(bytes)
  ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)
  ret% = BMPToString(PictureB.hDC, PictureB.Image, B$)

  bytes = StringBMP_and(A$, B$, RESULT$)

  ret% = StringToBmp(RESULT$, PictureResult.hDC, PictureResult.Image)
  PictureResult.Refresh

End Sub

Sub CommandCompareAtoB_Click ()
  Dim bytes As Long
  Dim A$, B$
  Dim ret%

  bytes = BMP_GetSize(PictureA.Image)
  If (bytes = 0) Then
     MsgBox ("Bitmap too large to store!")
     End
  End If
  A$ = Space$(bytes)
  B$ = Space$(bytes)
  ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)

  If BMP_GetSize(PictureB.Image) <> bytes Then
     MsgBox "Bitmaps must be same size to compare. "
     End
  End If
  ret% = BMPToString(PictureB.hDC, PictureB.Image, B$)

  bytes = StringBMP_Compare(A$, B$)

  MsgBox "This difference is " + Str$(bytes) + " pixels."

End Sub

Sub CommandCopyAtoB_Click ()
  Dim ret%
  B$ = A$
  ' Fill PictureBox with information in B$
  ret% = StringToBmp(B$, PictureB.hDC, PictureB.Image)
  ' Display the new information
   PictureB.Refresh
End Sub

Sub CommandCopyResultToB_Click ()
  Dim ret%

  ' Copy RESULT to B (STRINGS!)
  B$ = RESULT$

  ' Convert the new B$ to a picture and display it!
  ret% = StringToBmp(B$, PictureB.hDC, PictureB.Image)
  PictureB.Refresh

End Sub

Sub CommandDrawCircle_Click ()
  Dim ret%
  Dim bytes As Long

  ' Draw a black circle
  PictureA.FillStyle = 0

  PictureA.FillColor = RGB(0, 0, 0)
  PictureA.Circle (10, 10), 5, RGB(0, 0, 0)

  PictureA.FillColor = RGB(255, 0, 0)
  PictureA.Circle (40, 25), 5, RGB(255, 0, 0)

  PictureA.FillColor = RGB(0, 255, 0)
  PictureA.Circle (25, 30), 5, RGB(0, 255, 0)

  ' Determine the size of a string required to hold PictureA
  bytes = BMP_GetSize(PictureA.Image)
  If (bytes = 0) Then
     MsgBox ("Bitmap too large to store as a string!")
     End
  End If

  ' Create a string of the proper size to hold picture box.
  A$ = Space$(bytes)

  ' Convert PictureA into A$
  ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)

End Sub

Sub CommandInvertA_Click ()
  Dim bytes As Long
  Dim ret%
  Dim TEMP$

  ' Determine the size of a string required to hold PictureA
  bytes = BMP_GetSize(PictureA.Image)
  If (bytes = 0) Then
     MsgBox ("Bitmap too large to store!")
     End
  End If

  ' Make sure space is allocated to hold all pixels in strings.
  A$ = Space$(bytes)
  TEMP$ = Space$(bytes)

  ' Copy PictureA into A$
  ret% = BMPToString(PictureA.hDC, PictureA.Image, A$)

  ' Invert A$ and store the result in RESULT$
  ret% = StringBMP_Invert(A$, TEMP$)
  A$ = TEMP$

  ' Convert A$ into a picture box and display.
  ret% = StringToBmp(A$, PictureA.hDC, PictureA.Image)
  PictureA.Refresh

End Sub

Sub CommandOr_Click ()
  Dim bytes As Long
  Dim ret%

  ' Make sure string